home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / halcn305.zip / GSDMO_15.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-02  |  3KB  |  135 lines
  1. Program GSDMO_15;
  2. {------------------------------------------------------------------------------
  3.                           DBase File and Memo Builder
  4.  
  5.        Copyright (c)  Richard F. Griffin
  6.  
  7.        20 January 1993
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This program creates a dBase file 'GSDMO_15.DBF with memo file
  14.        'GSDMO_15.DBT'.  It shows how memo fields are built.
  15.  
  16.        New procedures/functions introduced are:
  17.  
  18.                  DTOS
  19.                  MemoClear
  20.                  MemoInsLine
  21.                  MemoPut
  22.  
  23. -------------------------------------------------------------------------------}
  24.  
  25. uses
  26.    GSOB_DBF,
  27.    GSOBShel,
  28.    {$IFDEF WINDOWS}
  29.       WinCRT,
  30.       WinDOS;
  31.    {$ELSE}
  32.       CRT,
  33.       DOS;
  34.    {$ENDIF}
  35.  
  36.  
  37. var
  38.    fli : text;
  39.    s   : string;
  40.    icnt: integer;
  41.    t   : string;
  42.  
  43.    gfLineName  : string[12];
  44.    gfBirthDate : string[8];
  45.    gfRandomNum : string[12];
  46.  
  47.  
  48. Procedure MakeTheFile(fname : string);
  49. var
  50.    f   : GSP_DB4Build;        {Create a dBase 3 format by using GSP_DB3Build}
  51. begin
  52.            {Create new dBase file}
  53.  
  54.    New(f, Init(fname));
  55.    f^.InsertField('LINENAME','C',30,0);
  56.    f^.InsertField('BIRTHDATE','D',8,0);
  57.    f^.InsertField('RANDOMNUM','N',12,5);
  58.    f^.InsertField('COMMENTS','M',10,0);
  59.    dispose(f, Done);
  60. end;
  61.  
  62.  
  63. Function RandString(l,h : integer) : string;
  64. var
  65.    v : integer;
  66.    g : string;
  67. begin
  68.    v := random((h-l)+1);
  69.    v := v + l;
  70.    str(v,g);
  71.    RandString := g;
  72. end;
  73.  
  74.  
  75. procedure BuildRecordData;
  76. var
  77.    k1  : word;
  78.    s1  : string[5];
  79. begin
  80.                {data for LINENAME}
  81.    str(icnt, gfLineName);
  82.    gfLineName := 'Line ' + gfLineName;
  83.                {data for BIRTHDATE}
  84.    k1 := random(25);
  85.    gfBirthDate := DTOS(Date - k1);
  86.                {data for RANDOMNUM}
  87.    k1 := random(2);
  88.    if k1 = 0 then gfRandomNum := '-' else gfRandomNum := '';
  89.    s1 := RandString(0,30000);
  90.    while length(s1) < 5 do s1 := s1+'0';
  91.    gfRandomNum := gfRandomNum + RandString(0,30000) + '.' + s1;
  92.    while length(gfRandomNum) < 12 do gfRandomNum := ' ' + gfRandomNum;
  93.                {data for COMMENTS}
  94.    MemoClear;                          {Erase the current memo buffer}
  95.    readln(fli, s);                     {Read a line of text}
  96.    MemoInsLine(0,s);                   {Insert text s at end of the memo}
  97. end;
  98.  
  99.  
  100. {--- Main Program ---}
  101.  
  102. begin
  103.            {Create new dBase file}
  104.  
  105.    Writeln('Creating the file..');
  106.    MakeTheFile('GSDMO_15');
  107.    Writeln('Finished');
  108.  
  109.            {Add records to the file}
  110.  
  111.    Select(1);
  112.    Use('GSDMO_15');
  113.    randomize;
  114.    assign(fli,'wisdom.fil');
  115.    reset(fli);
  116.    Writeln('Appending records to the file..');
  117.    for icnt := 1 to 20 do
  118.    begin
  119.       BuildRecordData;
  120.       ClearRecord;
  121.       FieldPut('LINENAME',gfLineName);
  122.       FieldPut('BIRTHDATE',gfBirthDate);
  123.       FieldPut('RANDOMNUM',gfRandomNum);
  124.       Writeln(gfLineName,'  ',gfBirthDate,'  ',gfRandomNum);
  125.       MemoPut('COMMENTS');             {Store the memo record}
  126.       Append;
  127.    end;
  128.  
  129.            {Dispose of objects (also closes the files}
  130.  
  131.    Writeln('Finished');
  132.    CloseDataBases;
  133.    close(fli);
  134. end.
  135.